home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyTextDisplay.p < prev    next >
Encoding:
Text File  |  1994-04-16  |  21.0 KB  |  805 lines  |  [TEXT/PJMM]
  1. unit MyTextDisplay;
  2.  
  3. interface
  4.  
  5.     type
  6.         LongArray = array[1..100000] of longInt;
  7.         LongArrayPtr = ^LongArray;
  8.         LongArrayHandle = ^LongArrayPtr;
  9.         MyTextDisplayRecord = record
  10. { You can change these and the call resize/recalc }
  11.                 leading: integer;
  12.                 width: integer;
  13.                 leave_room_for_grow: boolean;
  14. { You can read these }
  15.                 full_rect: rect;
  16.                 view: rect;
  17.                 view_lines: longInt;
  18.                 total_length: longInt;
  19.                 view_width: integer;
  20.                 top_line: longInt;
  21.                 selStart, selEnd: longInt;
  22.                 hoffset: integer;
  23.                 window: WindowPtr;
  24.                 hcontrol, vcontrol: ControlHandle;
  25.                 font: integer;
  26.                 size: integer;
  27.                 fi: FontInfo;
  28.                 line_height: longInt;
  29.                 rn: integer;
  30.                 lines: longInt;
  31. { You should ignore these }
  32.                 last_click_time: longInt;
  33.                 last_click_offset: longInt;
  34.                 double_click: boolean;
  35.                 offsets: LongArrayHandle;
  36.             end;
  37.         LongPoint = record
  38.                 v: longInt;
  39.                 h: longInt;
  40.             end;
  41.  
  42.     procedure MTDCreate (var mtd: MyTextDisplayRecord; window: WindowPtr; rn: integer; width: integer; hcontrol: boolean);
  43.     procedure MTDDestroy (var mtd: MyTextDisplayRecord);
  44.  
  45.     procedure MTDSetPort (var mtd: MyTextDisplayRecord);
  46.     procedure MTDSetFontSize (var mtd: MyTextDisplayRecord; font, size: integer);
  47.     procedure MTDRecalculate (var mtd: MyTextDisplayRecord; justappend: boolean);
  48.     procedure MTDDisplay (var mtd: MyTextDisplayRecord; draw_region: RgnHandle; fromline: longInt);
  49.     procedure MTDSetSelection (var mtd: MyTextDisplayRecord; start, fin: longInt);
  50.     procedure MTDGetSelectionData (var mtd: MyTextDisplayRecord; h: handle);
  51.     procedure MTDResize (var mtd: MyTextDisplayRecord; view: rect);
  52.     procedure MTDDoKey (var mtd: MyTextDisplayRecord; ch: char);
  53.     procedure MTDDoClick (var mtd: MyTextDisplayRecord; var er: EventRecord);
  54.     procedure MTDSetMouse (var mtd: MyTextDisplayRecord);
  55.     procedure MTDScroll (var mtd: MyTextDisplayRecord; scroll: LongPoint);
  56.  
  57. implementation
  58.  
  59.     uses
  60.         Script, MyTypes, MyMathUtils, MyFileSystemUtils;
  61.  
  62.     const
  63.         invis = 0;
  64.         vis = 255;
  65.         HiliteMode = $938;
  66.  
  67.     procedure SectRectRgn (rgn: RgnHandle; r: rect);
  68.         var
  69.             rrgn: RgnHandle;
  70.     begin
  71.         rrgn := NewRgn;
  72.         RectRgn(rrgn, r);
  73.         SectRgn(rgn, rrgn, rgn);
  74.         DisposeRgn(rrgn);
  75.     end;
  76.  
  77.     function MyFSReadChunkPos (refnum: integer; pos: longInt; len: integer; var s: str255): OSErr;
  78.         var
  79.             pb: ParamBlockRec;
  80.             err: OSErr;
  81.     begin
  82.         if len > 255 then
  83.             len := 255;
  84.         pb.ioRefNum := refnum;
  85. {$PUSH}
  86. {$R-}
  87.         pb.ioBuffer := @s[1];
  88.         pb.ioReqCount := len;
  89.         pb.ioPosMode := fsFromStart;
  90.         pb.ioPosOffset := pos;
  91.         err := PBReadSync(@pb);
  92.         if (err = eofErr) & (pb.ioActCount > 0) then begin
  93.             err := noErr;
  94.         end;
  95.         if err = noErr then begin
  96.             s[0] := chr(pb.ioActCount);
  97.         end;
  98. {$POP}
  99.         MyFSReadChunkPos := err;
  100.     end;
  101.  
  102.     procedure MTDSetPort (var mtd: MyTextDisplayRecord);
  103.     begin
  104.         SetPort(mtd.window);
  105.         TextFont(mtd.font);
  106.         TextSize(mtd.size);
  107.         TextFace([]);
  108.     end;
  109.  
  110.     procedure MTDOffsetToLine (var mtd: MyTextDisplayRecord; offset: longInt; var thisline: longInt);
  111.         var
  112.             s, m, f: longInt;
  113.     begin
  114.         if offset <= 0 then begin
  115.             thisline := 1;
  116.         end
  117.         else if offset >= mtd.total_length then begin
  118.             thisline := mtd.lines;
  119.         end
  120.         else begin
  121.             s := 1;
  122.             f := mtd.lines + 1;
  123.             while s < f do begin
  124.                 m := (f + s) div 2;
  125.                 if offset >= mtd.offsets^^[m] then
  126.                     s := m;
  127.                 if offset < mtd.offsets^^[m + 1] then
  128.                     f := m;
  129.                 if offset = mtd.offsets^^[m + 1] then begin { cheat to make it work with filelen }
  130.                     s := m + 1;
  131.                     leave;
  132.                 end;
  133.             end;
  134.             thisline := s;
  135.         end;
  136.     end;
  137.  
  138.     procedure MTDSetFontSize (var mtd: MyTextDisplayRecord; font, size: integer);
  139.     begin
  140.         mtd.font := font;
  141.         mtd.size := size;
  142.         if size = 0 then begin
  143.             mtd.leading := 2;
  144.         end
  145.         else begin
  146.             mtd.leading := size div 6;
  147.             if mtd.leading = 0 then
  148.                 mtd.leading := 1;
  149.         end;
  150.         MTDSetPort(mtd);
  151.         GetFontInfo(mtd.fi);
  152.         mtd.line_height := mtd.fi.ascent + mtd.fi.descent + mtd.leading;
  153.     end;
  154.  
  155.     procedure MTDSetControls (var mtd: MyTextDisplayRecord);
  156.         var
  157.             m: integer;
  158.     begin
  159.         mtd.vcontrol^^.contrlVis := invis;
  160.         m := Max(0, mtd.lines - mtd.view_lines);
  161.         SetCtlMax(mtd.vcontrol, m);
  162.         mtd.top_line := Pin(0, mtd.top_line, m);
  163.         SetCtlValue(mtd.vcontrol, mtd.top_line);
  164.         mtd.vcontrol^^.contrlVis := vis;
  165.         Draw1Control(mtd.vcontrol);
  166.  
  167.         if mtd.hcontrol <> nil then begin
  168.             mtd.hcontrol^^.contrlVis := invis;
  169.             m := Max(0, mtd.width - mtd.view_width);
  170.             SetCtlMax(mtd.hcontrol, m);
  171.             mtd.hoffset := Pin(0, mtd.hoffset, m);
  172.             SetCtlValue(mtd.hcontrol, mtd.hoffset);
  173.             mtd.hcontrol^^.contrlVis := vis;
  174.             Draw1Control(mtd.hcontrol);
  175.         end;
  176.     end;
  177.  
  178.     procedure MTDRecalculate (var mtd: MyTextDisplayRecord; justappend: boolean);
  179.         var
  180.             err: OSErr;
  181.             handlesize: longInt;
  182.             pos, nextpos: longInt;
  183.             offset, linebytes: longInt;
  184.             filelen: longInt;
  185.             line: str255;
  186.             slbc: StyledLineBreakCode;
  187.             textwidth: fixed;
  188.             orgoffset: longInt;
  189.             thisline: longInt;
  190.             initialline: longInt;
  191.     begin
  192.         MTDSetPort(mtd);
  193.         mtd.last_click_time := 0;
  194.         handlesize := GetHandleSize(handle(mtd.offsets)) div 4;
  195.         err := GetEOF(mtd.rn, filelen);
  196.         mtd.total_length := filelen;
  197.         if justappend & (mtd.lines > 1) then begin
  198.             mtd.lines := mtd.lines - 1;
  199.             pos := mtd.offsets^^[mtd.lines + 1];
  200.             orgoffset := maxLongInt;
  201.             initialline := 0; {mtd.lines}
  202.         end
  203.         else begin
  204.             orgoffset := mtd.offsets^^[Min(mtd.lines + 1, mtd.top_line + 1)];
  205.             mtd.lines := 0;
  206.             pos := 0;
  207.             initialline := 0;
  208.         end;
  209.         if err = noErr then begin
  210.             err := MyFSReadLineAt(mtd.rn, pos, line);
  211.             while err = noErr do begin
  212.                 nextpos := pos + length(line) + 1;
  213.                 offset := 0;
  214.                 while (offset = 0) or (offset < length(line)) do begin
  215.                     textwidth := BSL(mtd.width, 16);
  216.                     linebytes := 1;
  217. {$PUSH}
  218. {$R-}
  219.                     slbc := StyledLineBreak(@line[offset + 1], length(line) - offset, 0, length(line) - offset, 0, textwidth, linebytes);
  220. {$POP}
  221.                     mtd.lines := mtd.lines + 1;
  222.                     if mtd.lines > handlesize then begin
  223.                         handlesize := handlesize + 100;
  224.                         SetHandleSize(handle(mtd.offsets), handlesize * 4);
  225.                     end;
  226.                     mtd.offsets^^[mtd.lines] := pos + offset;
  227.                     if linebytes = 0 then begin
  228.                         offset := offset + 1;
  229.                     end
  230.                     else begin
  231.                         offset := offset + linebytes;
  232.                     end;
  233.                 end;
  234.                 pos := nextpos;
  235.                 err := MyFSReadLineAt(mtd.rn, pos, line);
  236.             end;
  237.         end;
  238.         SetHandleSize(handle(mtd.offsets), (mtd.lines + 1) * 4);
  239.         mtd.offsets^^[mtd.lines + 1] := filelen;
  240.         mtd.hoffset := 0;
  241.         MTDOffsetToLine(mtd, orgoffset, thisline);
  242.         mtd.top_line := Max(0, Min(thisline - 1, mtd.lines - mtd.view_lines));
  243.         MTDSetControls(mtd);
  244.         MTDDisplay(mtd, nil, initialline);
  245.     end;
  246.  
  247.     function MTDLinePosToHOffset (var mtd: MyTextDisplayRecord; var line: str255; linepos: integer): integer;
  248.     begin
  249. {$PUSH}
  250. {$R-}
  251.         MTDLinePosToHOffset := Char2Pixel(@line[1], length(line), 0, linepos, 1) + mtd.view.left - mtd.hoffset;
  252. {$POP}
  253.     end;
  254.  
  255.     function MTDHOffsetToLinePos (var mtd: MyTextDisplayRecord; var line: str255; hoffset: integer; var rightside: boolean): integer;
  256.         var
  257.             linepos: integer;
  258.     begin
  259. {$PUSH}
  260. {$R-}
  261.         linepos := Pixel2Char(@line[1], length(line), 0, hoffset, rightside);
  262. {$POP}
  263.         rightside := rightside <> false;
  264.         MTDHOffsetToLinePos := linepos;
  265.     end;
  266.  
  267.     procedure MTDDisplay (var mtd: MyTextDisplayRecord; draw_region: RgnHandle; fromline: longInt);
  268.         var
  269.             line: str255;
  270.         function LinePos (thisline, o: longInt): integer;
  271.             var
  272.                 base: longInt;
  273.         begin
  274.             base := mtd.offsets^^[thisline];
  275.             if o <= base then begin
  276.                 LinePos := mtd.view.left;
  277.             end
  278.             else if o >= mtd.offsets^^[thisline + 1] then begin
  279.                 LinePos := mtd.view.right;
  280.             end
  281.             else begin
  282.                 LinePos := MTDLinePosToHOffset(mtd, line, o - base);
  283.             end;
  284.         end;
  285.  
  286.         var
  287.             err: OSErr;
  288.             v: integer;
  289.             thisline: longInt;
  290.             s, f: longInt;
  291.             sh, fh: integer;
  292.             oldclip: RgnHandle;
  293.             r: rect;
  294.     begin
  295.         MTDSetPort(mtd);
  296.         oldclip := NewRgn;
  297.         GetClip(oldclip);
  298.         if draw_region = nil then begin
  299.             ClipRect(mtd.view);
  300.         end
  301.         else begin
  302.             SectRectRgn(draw_region, mtd.view);
  303.             SetClip(draw_region);
  304.         end;
  305.         v := mtd.view.top + mtd.fi.ascent;
  306.         for thisline := mtd.top_line + 1 to Min(mtd.lines, mtd.top_line + mtd.view_lines) do begin
  307.             if thisline >= fromline then begin
  308.                 err := MyFSReadChunkPos(mtd.rn, mtd.offsets^^[thisline], mtd.offsets^^[thisline + 1] - mtd.offsets^^[thisline], line);
  309.                 if err <> noErr then
  310.                     leave;
  311.                 r := mtd.view;
  312.                 r.top := v - mtd.fi.ascent - mtd.leading;
  313.                 r.bottom := v + mtd.fi.descent;
  314.                 MoveTo(mtd.view.left - mtd.hoffset, v);
  315.                 EraseRect(r);
  316.                 DrawString(line);
  317.                 s := mtd.selStart;
  318.                 f := mtd.selEnd;
  319.                 if (s < f) & (s < mtd.offsets^^[thisline + 1]) & (mtd.offsets^^[thisline] < f) then begin { Selection }
  320.                     sh := LinePos(thisline, s);
  321.                     fh := LinePos(thisline, f);
  322.                     BitClr(POINTER(HiliteMode), pHiliteBit);
  323.                     InvertRect(v - mtd.fi.ascent - mtd.leading, sh, v + mtd.fi.descent, fh);
  324.                 end;
  325.             end;
  326.             v := v + mtd.line_height;
  327.         end;
  328.         SetClip(oldclip);
  329.         DisposeRgn(oldclip);
  330.     end;
  331.  
  332.     procedure MTDScroll (var mtd: MyTextDisplayRecord; scroll: LongPoint);
  333.         var
  334.             update: RgnHandle;
  335.     begin
  336.         scroll.v := Pin(-mtd.top_line, scroll.v, Max(0, mtd.lines - mtd.top_line - mtd.view_lines));
  337.         scroll.h := Pin(-mtd.hoffset, scroll.h, Max(0, mtd.width - mtd.hoffset - mtd.view_width));
  338.         if (scroll.v <> 0) or (scroll.h <> 0) then begin
  339.             update := NewRgn;
  340.             ScrollRect(mtd.view, -scroll.h, -scroll.v * mtd.line_height, update);
  341.             mtd.hoffset := mtd.hoffset + scroll.h;
  342.             mtd.top_line := mtd.top_line + scroll.v;
  343.             MTDDisplay(mtd, update, 0);
  344.             DisposeRgn(update);
  345.             MTDSetControls(mtd);
  346.         end;
  347.     end;
  348.  
  349. {WARNING: Only really valid for pts inside mtd.view! }
  350.     procedure MTDPointToOffset (var mtd: MyTextDisplayRecord; pt: Point; var thisline, offset: longInt; var rightside: boolean; var line: str255; var scroll: LongPoint);
  351.         var
  352.             last_line: longInt;
  353.             h: integer;
  354.             err: OSErr;
  355.     begin
  356.         rightside := false;
  357.         scroll.h := 0;
  358.         scroll.v := 0;
  359.         line := '';
  360.         last_line := Min(mtd.top_line + mtd.view_lines, mtd.lines);
  361.         if pt.v < mtd.view.top then begin
  362.             scroll.v := -((mtd.view.top - pt.v) div mtd.line_height + 1);
  363.             offset := mtd.offsets^^[mtd.top_line + 1];
  364.             thisline := mtd.top_line + 1;
  365.         end
  366.         else if pt.v > mtd.view.bottom then begin
  367.             scroll.v := (pt.v - mtd.view.bottom) div mtd.line_height + 1;
  368.             offset := mtd.offsets^^[last_line + 1];
  369.             thisline := last_line;
  370.             rightside := false;
  371.         end
  372.         else begin
  373.             if pt.h < mtd.view.left then begin
  374.                 scroll.h := pt.h - mtd.view.left;
  375.             end
  376.             else if pt.h > mtd.view.right then begin
  377.                 scroll.h := pt.h - mtd.view.right;
  378.             end;
  379.             thisline := mtd.top_line + (pt.v - mtd.view.top) div mtd.line_height + 1;
  380.             if thisline > mtd.lines then begin
  381.                 thisline := mtd.lines + 1;
  382.                 offset := mtd.total_length;
  383.                 rightside := false;
  384.             end
  385.             else begin
  386.                 h := Max(0, pt.h - mtd.view.left + mtd.hoffset);
  387.                 err := MyFSReadChunkPos(mtd.rn, mtd.offsets^^[thisline], mtd.offsets^^[thisline + 1] - mtd.offsets^^[thisline], line);
  388.                 offset := MTDHOffsetToLinePos(mtd, line, h, rightside);
  389.                 if offset >= length(line) then begin
  390.                     offset := length(line);
  391.                     rightside := false;
  392.                 end;
  393.                 offset := mtd.offsets^^[thisline] + offset;
  394.             end;
  395.         end;
  396.     end;
  397.  
  398.     procedure MTDReadLine (var mtd: MyTextDisplayRecord; theline: longInt; var line: str255);
  399.         var
  400.             err: OSErr;
  401.     begin
  402.         line := '';
  403.         if theline <= mtd.lines then
  404.             err := MyFSReadChunkPos(mtd.rn, mtd.offsets^^[theline], mtd.offsets^^[theline + 1], line);
  405.     end;
  406.  
  407.     procedure MTDOffsetToPoint (var mtd: MyTextDisplayRecord; offset: longInt; var pt: Point);
  408.         var
  409.             thisline: longInt;
  410.             h: integer;
  411.             line: str255;
  412.     begin
  413.         MTDOffsetToLine(mtd, offset, thisline);
  414.         if thisline <= mtd.top_line then begin
  415.             pt := mtd.view.topleft;
  416.             pt.v := pt.v - mtd.line_height;
  417.         end
  418.         else if thisline > mtd.top_line + mtd.view_lines + 1 then begin
  419.             pt := mtd.view.botright;
  420.             pt.v := pt.v + mtd.line_height;
  421.         end
  422.         else begin
  423.             MTDReadLine(mtd, thisline, line);
  424.             pt.v := (thisline - mtd.top_line - 1) * mtd.line_height + mtd.leading + mtd.fi.ascent;
  425.             pt.h := MTDLinePosToHOffset(mtd, line, offset - mtd.offsets^^[thisline]);
  426.         end;
  427.     end;
  428.  
  429.     procedure UnionRectRgn (rgn: RgnHandle; l, t, r, b: integer);
  430.         var
  431.             rrgn: RgnHandle;
  432.     begin
  433.         rrgn := NewRgn;
  434.         SetRectRgn(rrgn, l, t, r, b);
  435.         UnionRgn(rgn, rrgn, rgn);
  436.         DisposeRgn(rrgn);
  437.     end;
  438.  
  439.     procedure MTDGetSelectionData (var mtd: MyTextDisplayRecord; h: handle);
  440.         var
  441.             err: OSErr;
  442.     begin
  443.         HUnlock(h);
  444.         SetHandleSize(h, 0);
  445.         SetHandleSize(h, mtd.selEnd - mtd.selStart);
  446.         err := MyFSReadAt(mtd.rn, mtd.selStart, GetHandleSize(h), h^);
  447.         if err <> noErr then begin
  448.             SetHandleSize(h, 0);
  449.         end;
  450.     end;
  451.  
  452.     procedure MTDSetSelection (var mtd: MyTextDisplayRecord; start, fin: longInt);
  453.         function InView (v: integer): boolean;
  454.         begin
  455.             InView := (mtd.view.top <= v) & (v <= mtd.view.bottom);
  456.         end;
  457.         procedure GetSelRgn (s, f: longInt; r: RgnHandle);
  458.             var
  459.                 sp, fp: Point;
  460.                 ascent, descent, left, right, top, bottom: integer;
  461.                 t, b: integer;
  462.         begin
  463.             if s < f then begin
  464.                 MTDOffsetToPoint(mtd, s, sp);
  465.                 MTDOffsetToPoint(mtd, f, fp);
  466.                 ascent := mtd.fi.ascent + mtd.leading;
  467.                 descent := mtd.fi.descent;
  468.                 left := mtd.view.left;
  469.                 right := mtd.view.right;
  470.                 top := mtd.view.top;
  471.                 bottom := mtd.view.bottom;
  472.                 if sp.v = fp.v then begin
  473.                     if InView(sp.v) then begin
  474.                         SetRectRgn(r, sp.h, sp.v - ascent, fp.h, sp.v + descent);
  475.                     end;
  476.                 end
  477.                 else begin
  478.                     if InView(sp.v) then begin
  479.                         SetRectRgn(r, sp.h, sp.v - ascent, right, sp.v + descent);
  480.                         t := sp.v + descent;
  481.                     end
  482.                     else begin
  483.                         t := top;
  484.                     end;
  485.                     if InView(fp.v) then begin
  486.                         UnionRectRgn(r, left, fp.v - ascent, fp.h, fp.v + descent);
  487.                         b := fp.v - ascent;
  488.                     end
  489.                     else begin
  490.                         b := bottom;
  491.                     end;
  492.                     UnionRectRgn(r, left, t, right, b);
  493.                 end;
  494.             end;
  495.             SectRectRgn(r, mtd.view);
  496.         end;
  497.         var
  498.             orgn, nrgn: RgnHandle;
  499.     begin
  500.         if (start <> mtd.selStart) or (fin <> mtd.selEnd) then begin
  501.             MTDSetPort(mtd);
  502.             orgn := NewRgn;
  503.             nrgn := NewRgn;
  504.             GetSelRgn(mtd.selStart, mtd.selEnd, orgn);
  505.             mtd.selStart := start;
  506.             mtd.selEnd := fin;
  507.             GetSelRgn(mtd.selStart, mtd.selEnd, nrgn);
  508.             XorRgn(orgn, nrgn, nrgn);
  509.             BitClr(POINTER(HiliteMode), pHiliteBit);
  510.             InvertRgn(nrgn);
  511.             DisposeRgn(nrgn);
  512.             DisposeRgn(orgn);
  513.         end;
  514.     end;
  515.  
  516.     procedure MTDResize (var mtd: MyTextDisplayRecord; view: rect);
  517.     begin
  518.         mtd.vcontrol^^.contrlVis := invis;
  519.         if mtd.hcontrol <> nil then begin
  520.             mtd.hcontrol^^.contrlVis := invis;
  521.         end;
  522.  
  523.         EraseRect(mtd.full_rect);
  524.         InvalRect(mtd.full_rect);
  525.  
  526.         mtd.full_rect := view;
  527.         mtd.view := view;
  528.         mtd.view.right := view.right - 16;
  529.         if (mtd.hcontrol <> nil) then begin
  530.             mtd.view.bottom := mtd.view.bottom - 16;
  531.         end;
  532.         InsetRect(mtd.view, mtd.leading, mtd.leading);
  533.         mtd.view_lines := (mtd.view.bottom - mtd.view.top) div mtd.line_height;
  534.         mtd.view.bottom := mtd.view.top + mtd.view_lines * mtd.line_height - mtd.leading;
  535.         mtd.view_width := mtd.view.right - mtd.view.left;
  536.         if mtd.width = 0 then begin
  537.             mtd.width := mtd.view_width;
  538.         end;
  539.  
  540.         MoveControl(mtd.vcontrol, view.right - 15, view.top - 1);
  541.         SizeControl(mtd.vcontrol, 16, view.bottom - view.top - 16 * ord(mtd.leave_room_for_grow) + 3);
  542.  
  543.         if mtd.hcontrol <> nil then begin
  544.             MoveControl(mtd.hcontrol, view.left - 1, view.bottom - 15);
  545.             SizeControl(mtd.hcontrol, view.right - view.left - 13, 16);
  546.         end;
  547.  
  548.         MTDRecalculate(mtd, false);
  549.     end;
  550.  
  551.     procedure MTDCreate (var mtd: MyTextDisplayRecord; window: WindowPtr; rn: integer; width: integer; hcontrol: boolean);
  552.         var
  553.             bounds: rect;
  554.     begin
  555.         mtd.window := window;
  556.         SetRect(mtd.view, 0, 0, 0, 0);
  557.         mtd.width := width;
  558.         mtd.leave_room_for_grow := true;
  559.         mtd.rn := rn;
  560.         mtd.lines := 0;
  561.         mtd.total_length := 0;
  562.         mtd.top_line := 0;
  563.         mtd.hoffset := 0;
  564.         mtd.selStart := 0;
  565.         mtd.selEnd := 0;
  566.         mtd.last_click_time := 0;
  567.         mtd.offsets := LongArrayHandle(NewHandleClear(4));
  568.         SetRect(bounds, 0, 0, 15, 100);
  569.         mtd.vcontrol := NewControl(window, bounds, '', false, 0, 0, 0, scrollBarProc, ord(@mtd));
  570.         if hcontrol then begin
  571.             SetRect(bounds, 0, 0, 100, 15);
  572.             mtd.hcontrol := NewControl(window, bounds, '', false, 0, 0, 0, scrollBarProc, ord(@mtd));
  573.         end
  574.         else begin
  575.             mtd.hcontrol := nil;
  576.         end;
  577.         MTDSetFontSize(mtd, 0, 0);
  578.     end;
  579.  
  580.     var
  581.         action_mte: ^MyTextDisplayRecord;
  582.         action_amount: LongPoint;
  583.  
  584.     procedure MTDActionProc (control: ControlHandle; part: integer);
  585.         var
  586.             amount: integer;
  587.             window: WindowPtr;
  588.     begin
  589.         if (part <> 0) then begin
  590.             MTDScroll(action_mte^, action_amount);
  591.         end;
  592.     end;
  593.  
  594.     procedure GetActionAmount (var mtd: MyTextDisplayRecord; control: ControlHandle; part: integer; var scroll: LongPoint);
  595.         var
  596.             amount, amount_pg, amount_line: integer;
  597.     begin
  598.         if control = mtd.vcontrol then begin
  599.             amount_pg := mtd.view_lines - 1;
  600.             amount_line := 1;
  601.         end
  602.         else begin
  603.             amount_pg := mtd.view_width;
  604.             amount_line := 8; { a few pixels }
  605.         end;
  606.         case part of
  607.             inUpButton: 
  608.                 amount := -amount_line;
  609.             inDownButton: 
  610.                 amount := amount_line;
  611.             inPageUp: 
  612.                 amount := -amount_pg;
  613.             inPageDown: 
  614.                 amount := amount_pg;
  615.             otherwise
  616.                 amount := 0;
  617.         end;
  618.         if control = mtd.vcontrol then begin
  619.             scroll.h := 0;
  620.             scroll.v := amount;
  621.         end
  622.         else begin
  623.             scroll.h := amount;
  624.             scroll.v := 0;
  625.         end;
  626.     end;
  627.  
  628.     procedure MTDDoClick (var mtd: MyTextDisplayRecord; var er: EventRecord);
  629.         var
  630.             click_type: (CT_First, CT_Double, CT_Tripple);
  631.             rightside: boolean;
  632.             thisline: longInt;
  633.             line: str255;
  634.         procedure GetCurrentPos (offset: longInt; var s, f: longInt);
  635.             var
  636.                 base: longInt;
  637.                 offtab: OffsetTable;
  638.         begin
  639.             base := mtd.offsets^^[thisline];
  640.             case click_type of
  641.                 CT_First:  begin
  642.                     s := offset + ord(rightside);
  643.                     f := offset + ord(rightside);
  644.                 end;
  645.                 CT_Double:  begin
  646. {$PUSH}
  647. {$R-}
  648.                     FindWord(@line[1], length(line), offset - base, rightside, nil, offtab);
  649. {$POP}
  650.                     s := base + offtab[0].offFirst;
  651.                     f := base + offtab[0].offSecond;
  652.                 end;
  653.                 CT_Tripple:  begin
  654.                     s := base;
  655.                     if thisline <= mtd.lines then begin
  656.                         f := mtd.offsets^^[thisline + 1];
  657.                     end
  658.                     else begin
  659.                         f := base;
  660.                     end;
  661.                 end;
  662.             end; { case }
  663.         end;
  664.  
  665.         var
  666.             pt: Point;
  667.             control: ControlHandle;
  668.             part: integer;
  669.             scroll: LongPoint;
  670.             offset, ancors, ancorf, s, f, value: longInt;
  671.             shift: boolean;
  672.             lastoffset: longint;
  673.             amount: longInt;
  674.     begin
  675.         MTDSetPort(mtd);
  676.         pt := er.where;
  677.         GlobalToLocal(pt);
  678.         if PtInRect(pt, mtd.view) then begin
  679.             shift := BAND(er.modifiers, shiftKey) <> 0;
  680.             MTDPointToOffset(mtd, pt, thisline, offset, rightside, line, scroll);
  681.             if not shift & (er.when - mtd.last_click_time <= GetDblTime) & (offset = mtd.last_click_offset) then begin
  682.                 if mtd.double_click then begin
  683.                     click_type := CT_Tripple;
  684.                 end
  685.                 else begin
  686.                     click_type := CT_Double;
  687.                 end;
  688.                 mtd.double_click := true;
  689.             end
  690.             else begin
  691.                 click_type := CT_First;
  692.                 mtd.double_click := false;
  693.                 mtd.last_click_offset := offset;
  694.             end;
  695.             if not shift then begin
  696.                 GetCurrentPos(offset, ancors, ancorf);
  697.             end
  698.             else begin
  699.                 if mtd.selStart < mtd.selEnd then begin
  700.                     if offset > mtd.selStart then begin
  701.                         ancors := mtd.selStart;
  702.                         ancorf := mtd.selStart;
  703.                     end
  704.                     else begin
  705.                         ancors := mtd.selEnd;
  706.                         ancorf := mtd.selEnd;
  707.                     end;
  708.                 end
  709.                 else begin
  710.                     ancors := offset;
  711.                     ancorf := offset;
  712.                 end;
  713.             end;
  714.             MTDSetSelection(mtd, ancors, ancorf);
  715.             while StillDown do begin
  716.                 GetMouse(pt);
  717.                 MTDPointToOffset(mtd, pt, thisline, offset, rightside, line, scroll);
  718.                 GetCurrentPos(offset, s, f);
  719.                 MTDSetSelection(mtd, Min(ancors, s), Max(ancorf, f));
  720.                 MTDScroll(mtd, scroll);
  721.             end;
  722.             mtd.last_click_time := TickCount;
  723.         end
  724.         else begin
  725.             part := FindControl(pt, mtd.window, control);
  726.             if part <> 0 then begin
  727.                 if part = inThumb then begin
  728.                     value := GetCtlValue(control);
  729.                     part := TrackControl(control, pt, nil);
  730.                     if part <> 0 then begin
  731.                         amount := GetCtlValue(control) - value;
  732.                         if amount <> 0 then begin
  733.                             if control = mtd.vcontrol then begin
  734.                                 scroll.v := amount;
  735.                                 scroll.h := 0;
  736.                             end
  737.                             else begin
  738.                                 scroll.h := amount;
  739.                                 scroll.v := 0;
  740.                             end;
  741.                             MTDScroll(mtd, scroll);
  742.                         end;
  743.                     end;
  744.                 end
  745.                 else begin
  746.                     GetActionAmount(mtd, control, part, action_amount);
  747.                     action_mte := @mtd;
  748.                     value := TrackControl(control, pt, @MTDActionProc)
  749.                 end;
  750.             end
  751.             else begin
  752.                 SysBeep(1);
  753.             end;
  754.         end;
  755.     end;
  756.  
  757.     procedure MTDDoKey (var mtd: MyTextDisplayRecord; ch: char);
  758.         var
  759.             scroll: LongPoint;
  760.     begin
  761.         scroll.h := 0;
  762.         scroll.v := 0;
  763.         case ord(ch) of
  764.             homeChar:  begin
  765.                 scroll.v := -mtd.lines;
  766.             end;
  767.             endChar:  begin
  768.                 scroll.v := mtd.lines;
  769.             end;
  770.             pageUpChar:  begin
  771.                 GetActionAmount(mtd, mtd.vcontrol, inPageUp, scroll);
  772.             end;
  773.             pageDownChar:  begin
  774.                 GetActionAmount(mtd, mtd.vcontrol, inPageDown, scroll);
  775.             end;
  776.             otherwise
  777.                 SysBeep(1);
  778.         end;
  779.         MTDScroll(mtd, scroll);
  780.     end;
  781.  
  782.     procedure MTDSetMouse (var mtd: MyTextDisplayRecord);
  783.         var
  784.             pt: point;
  785.     begin
  786.         SetPort(mtd.window);
  787.         GetMouse(pt);
  788.         if PtInRect(pt, mtd.view) then begin
  789.             SetCursor(GetCursor(iBeamCursor)^^);
  790.         end
  791.         else begin
  792.             SetCursor(arrow);
  793.         end;
  794.     end;
  795.  
  796.     procedure MTDDestroy (var mtd: MyTextDisplayRecord);
  797.     begin
  798.         DisposeHandle(handle(mtd.offsets));
  799. {    DisposeControl(mtd.vcontrol);}
  800.         if mtd.hcontrol <> nil then begin
  801. {    DisposeControl(mtd.hcontrol);}
  802.         end;
  803.     end;
  804.  
  805. end.